Imports System
Imports System.Data
Imports System.Web
Imports System.Web.SessionState
Imports System.IO
Imports System.Text
Imports System.Xml
Imports System.Xml.Xsl
Imports System.Threading

Namespace xpComponent.Data
    Public Class ExportToExcel
        Public Enum ExportFormat
            CSV = 1
            Excel = 2
        End Enum

        Private response As System.Web.HttpResponse
        Private appType As String

        Public Sub New()
            appType = "Web"
            response = System.Web.HttpContext.Current.Response
        End Sub

        Public Sub New(ByVal ApplicationType As String)
            appType = ApplicationType
            If (appType <> "Web") And (appType <> "Win") Then Throw New Exception("Provide valid application format (Web/Win)")
            If (appType = "Web") Then response = System.Web.HttpContext.Current.Response
        End Sub

        Private _ns As String = "http://localhost"
        Public Property NetServer() As String
            Get
                Return Me._ns
            End Get
            Set(ByVal Value As String)
                Me._ns = Value
            End Set
        End Property

        Private Encode As Encoding = Encoding.Default
        Public Property EncodeFormat() As Encoding
            Get
                Return Me.Encode
            End Get
            Set(ByVal Value As Encoding)
                Me.Encode = Value
            End Set
        End Property

        'Function  : ExportDetails 
        'Arguments : DetailsTable, FormatType, FileName
        'Purpose	 : To get all the column headers in the datatable and 
        '               exorts in CSV / Excel format with all columns
        Public Sub ExportDetails(ByVal DetailsTable As DataTable, ByVal FormatType As ExportFormat, ByVal FileName As String)
            Try
                If (DetailsTable.Rows.Count = 0) Then Throw New Exception("There are no details to export.")

                'Create Dataset
                Dim dsExport As DataSet = New DataSet("Export")
                Dim dtExport As DataTable = DetailsTable.Copy()
                dtExport.TableName = "Values"
                dsExport.Tables.Add(dtExport)

                'Getting Field Names
                Dim sHeaders() As String = New String() {dtExport.Columns.Count}
                Dim sFileds() As String = New String() {dtExport.Columns.Count}

                Dim i As Integer
                For i = 0 To i <= dtExport.Columns.Count - 1
                    sHeaders(i) = dtExport.Columns(i).ColumnName
                    sFileds(i) = dtExport.Columns(i).ColumnName
                Next

                If (appType = "Web") Then
                    Export_with_XSLT_Web(dsExport, sHeaders, sFileds, FormatType, FileName)
                ElseIf (appType = "Win") Then
                    Export_with_XSLT_Windows(dsExport, sHeaders, sFileds, FormatType, FileName)
                End If

            Catch ex As Exception
                Throw ex
            End Try
        End Sub

        'Function  : ExportDetails 
        'Arguments : DetailsTable, ColumnList, FormatType, FileName		
        'Purpose	 : To get the specified column headers in the datatable and
        '            exorts in CSV / Excel format with specified columns
        Public Sub ExportDetails(ByVal DetailsTable As DataTable, ByVal ColumnList() As Integer, ByVal FormatType As ExportFormat, ByVal FileName As String)
            Try
                If (DetailsTable.Rows.Count = 0) Then Throw New Exception("There are no details to export")
                'Create Dataset
                Dim dsExport As DataSet = New DataSet("Export")
                Dim dtExport As DataTable = DetailsTable.Copy()
                dtExport.TableName = "Values"
                dsExport.Tables.Add(dtExport)

                If (ColumnList.Length > dtExport.Columns.Count) Then Throw New Exception("ExportColumn List should not exceed Total Columns")
                'Getting Field Names
                Dim sHeaders() As String = New String() {ColumnList.Length}
                Dim sFileds() As String = New String() {ColumnList.Length}

                Dim i As Integer = 0
                For i = 0 To i <= ColumnList.Length - 1
                    If ((ColumnList(i) < 0) Or (ColumnList(i) >= dtExport.Columns.Count)) Then Throw New Exception("ExportColumn Number should not exceed Total Columns Range")
                    sHeaders(i) = dtExport.Columns(ColumnList(i)).ColumnName
                    sFileds(i) = dtExport.Columns(ColumnList(i)).ColumnName
                Next
                If (appType = "Web") Then
                    Export_with_XSLT_Web(dsExport, sHeaders, sFileds, FormatType, FileName)
                ElseIf (appType = "Win") Then
                    Export_with_XSLT_Windows(dsExport, sHeaders, sFileds, FormatType, FileName)
                End If
            Catch ex As Exception
                Throw ex
            End Try
        End Sub

        'Function  : ExportDetails 
        'Arguments : DetailsTable, ColumnList, Headers, FormatType, FileName	
        'Purpose	 : To get the specified column headers in the datatable and	
        '            exorts in CSV / Excel format with specified columns and 
        '            with specified headers
        Public Sub ExportDetails(ByVal DetailsTable As DataTable, ByVal ColumnList() As Integer, ByVal Headers() As String, ByVal FormatType As ExportFormat, ByVal FileName As String)
            Try
                If (DetailsTable.Rows.Count = 0) Then Throw New Exception("There are no details to export")

                'Create Dataset
                Dim dsExport As DataSet = New DataSet("Export")
                Dim dtExport As DataTable = DetailsTable.Copy()
                dtExport.TableName = "Values"
                dsExport.Tables.Add(dtExport)

                If (ColumnList.Length <> Headers.Length) Then
                    Throw New Exception("ExportColumn List and Headers List should be of same length")
                ElseIf (ColumnList.Length > dtExport.Columns.Count) Or (Headers.Length > dtExport.Columns.Count) Then
                    Throw New Exception("ExportColumn List should not exceed Total Columns")
                End If

                'Getting Field Names
                Dim sFileds() As String = New String() {ColumnList.Length}
                Dim i As Integer = 0
                For i = 0 To i <= ColumnList.Length - 1
                    If (ColumnList(i) < 0) Or (ColumnList(i) >= dtExport.Columns.Count) Then Throw New Exception("ExportColumn Number should not exceed Total Columns Range")
                    sFileds(i) = dtExport.Columns(ColumnList(i)).ColumnName
                Next

                If (appType = "Web") Then
                    Export_with_XSLT_Web(dsExport, Headers, sFileds, FormatType, FileName)
                ElseIf (appType = "Win") Then
                    Export_with_XSLT_Windows(dsExport, Headers, sFileds, FormatType, FileName)
                End If
            Catch ex As Exception
                Throw ex
            End Try
        End Sub

        'Function  : WriteStylesheet 
        'Arguments : writer, sHeaders, sFileds, FormatType
        'Purpose   : Creates XSLT file to apply on dataset's XML file 
        Private Sub CreateStylesheet(ByVal writer As XmlTextWriter, ByVal sHeaders() As String, ByVal sFileds() As String, ByVal FormatType As ExportFormat)
            Try
                'xsl:stylesheet
                '<?xml version="1.0" encoding="ISO-8859-1" ?>
                '<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">

                Dim ns As String = Me._ns '"http://localhost"
                writer.Formatting = Formatting.Indented
                writer.WriteStartDocument()
                writer.WriteStartElement("xsl", "stylesheet", ns)
                writer.WriteAttributeString("version", "1.0")
                writer.WriteStartElement("xsl:output")
                writer.WriteAttributeString("method", "text")
                writer.WriteAttributeString("version", "4.0")
                writer.WriteEndElement()

                'xsl-template
                writer.WriteStartElement("xsl:template")
                writer.WriteAttributeString("match", "/")

                'xsl:value-of for headers
                Dim i As Integer = 0
                For i = 0 To i <= sHeaders.Length - 1
                    writer.WriteString("\""")
                    writer.WriteStartElement("xsl:value-of")
                    writer.WriteAttributeString("select", "'" + sHeaders(i) + "'")
                    writer.WriteEndElement()
                    writer.WriteString("\""")
                    If (i <> sFileds.Length - 1) Then writer.WriteString((FormatType = ExportFormat.CSV) & " ? , : 	")
                Next

                'xsl:for-each
                writer.WriteStartElement("xsl:for-each")
                writer.WriteAttributeString("select", "Export/Values")
                writer.WriteString("\r\n")

                'xsl:value-of for data fields
                For i = 0 To i <= sFileds.Length - 1
                    writer.WriteString("\""")
                    writer.WriteStartElement("xsl:value-of")
                    writer.WriteAttributeString("select", sFileds(i))
                    writer.WriteEndElement() 'xsl:value-of
                    writer.WriteString("\""")
                    If (i <> sFileds.Length - 1) Then writer.WriteString((FormatType = ExportFormat.CSV) & " ? , : 	")
                Next

                writer.WriteEndElement() 'xsl:for-each
                writer.WriteEndElement() 'xsl-template
                writer.WriteEndElement() 'xsl:stylesheet
                writer.WriteEndDocument()
            Catch ex As Exception
                Throw ex
            End Try
        End Sub

        'Function  : Export_with_XSLT_Web 
        'Arguments : dsExport, sHeaders, sFileds, FormatType, FileName
        'Purpose   : Exports dataset into CSV / Excel format
        Private Sub Export_with_XSLT_Web(ByVal dsExport As DataSet, ByVal sHeaders() As String, ByVal sFileds() As String, ByVal FormatType As ExportFormat, ByVal FileName As String)
            Try
                'Appending Headers
                response.Clear()
                response.Buffer = True

                If (FormatType = ExportFormat.CSV) Then
                    response.ContentType = "text/csv"
                    response.AppendHeader("content-disposition", "attachment; filename=" + FileName)
                Else
                    response.ContentType = "application/vnd.ms-excel"
                    response.AppendHeader("content-disposition", "attachment; filename=" + FileName)
                End If

                'XSLT to use for transforming this dataset.						
                Dim Stream As MemoryStream = New MemoryStream
                Dim writer As XmlTextWriter = New XmlTextWriter(Stream, Me.Encode)

                CreateStylesheet(writer, sHeaders, sFileds, FormatType)
                writer.Flush()
                Stream.Seek(0, SeekOrigin.Begin)

                Dim xmlDoc As XmlDataDocument = New XmlDataDocument(dsExport)
                Dim xslTran As XslTransform = New XslTransform
                xslTran.Load(New XmlTextReader(Stream), Nothing, Nothing)

                Dim sw As System.IO.StringWriter = New System.IO.StringWriter
                xslTran.Transform(xmlDoc, Nothing, sw, Nothing)

                'Writeout the Content				
                response.Write(sw.ToString())
                sw.Close()
                writer.Close()
                Stream.Close()
                response.End()
            Catch Ex As ThreadAbortException
                Dim ErrMsg As String = Ex.Message
            Catch ex As Exception
                Throw ex
            End Try
        End Sub

        'Function  : Export_with_XSLT_Windows 
        'Arguments : dsExport, sHeaders, sFileds, FormatType, FileName
        'Purpose   : Exports dataset into CSV / Excel format
        Private Sub Export_with_XSLT_Windows(ByVal dsExport As DataSet, ByVal sHeaders() As String, ByVal sFileds() As String, ByVal FormatType As ExportFormat, ByVal FileName As String)
            Try
                'XSLT to use for transforming this dataset.						
                Dim stream As MemoryStream = New MemoryStream
                Dim writer As XmlTextWriter = New XmlTextWriter(stream, Me.Encode)

                CreateStylesheet(writer, sHeaders, sFileds, FormatType)
                writer.Flush()
                stream.Seek(0, SeekOrigin.Begin)

                Dim xmlDoc As XmlDataDocument = New XmlDataDocument(dsExport)
                Dim xslTran As XslTransform = New XslTransform
                xslTran.Load(New XmlTextReader(stream), Nothing, Nothing)

                Dim sw As System.IO.StringWriter = New System.IO.StringWriter
                xslTran.Transform(xmlDoc, Nothing, sw, Nothing)

                'Writeout the Content									
                Dim strwriter As StreamWriter = New StreamWriter(FileName)
                strwriter.WriteLine(sw.ToString())
                strwriter.Close()

                sw.Close()
                writer.Close()
                stream.Close()
            Catch ex As Exception
                Throw ex
            End Try
        End Sub
    End Class
End Namespace

'Public Function ExportRequest() As String
'            On Error GoTo err_Handler

'            ' Excel object variables
'            Dim appExcel As Excel.Application
'            Dim wbk As Excel.Workbook
'            Dim wks As Excel.Worksheet
'            Dim sTemplate As String
'            Dim sTempFile As String
'            Dim sOutput As String

'            Dim dbs As DAO.Database
'            Dim rst As DAO.Recordset
'            Dim sSQL As String
'            Dim lRecords As Long
'            Dim iRow As Integer
'            Dim iCol As Integer
'            Dim iFld As Integer

'            Const cTabTwo As Byte = 2
'            Const cStartRow As Byte = 4
'            Const cStartColumn As Byte = 3

'            DoCmd.Hourglass(True)

'            ' set to break on all errors
'            Application.SetOption("Error Trapping", 0)

'            ' start with a clean file built from the template file
'            sTemplate = CurrentProject.Path & "\SalesTemplate.xls"
'            sOutput = CurrentProject.Path & "\SalesOutput.xls"
'            If Dir(sOutput) <> "" Then Kill(sOutput)
'            FileCopy(sTemplate, sOutput)

'            ' Create the Excel Applicaiton, Workbook and Worksheet and Database object
'            appExcel = Excel.Application
'            wbk = appExcel.Workbooks.Open(sOutput)
'            wks = appExcel.Worksheets(cTabTwo)
'            sSQL = "select * from qrySales"
'            dbs = CurrentDb
'            rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)

'            ' For this template, the data must be placed on the 4th row, third column.
'            ' (these values are set to constants for easy future modifications)
'            iCol = cStartColumn
'            iRow = cStartRow
'            If Not rst.BOF Then rst.MoveFirst()
'            Do Until rst.EOF
'                iFld = 0
'                lRecords = lRecords + 1
'                Me.lblMsg.Caption = "Exporting record #" & lRecords & " to SalesOutput.xls"
'                Me.Repaint()

'                For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
'                    wks.Cells(iRow, iCol) = rst.Fields(iFld)

'                    If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
'                        wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
'                    End If

'                    wks.Cells(iRow, iCol).WrapText = False
'                    iFld = iFld + 1
'                Next

'                wks.Rows(iRow).EntireRow.AutoFit()
'                iRow = iRow + 1
'                rst.MoveNext()
'            Loop

'            ExportRequest = "Total of " & lRecords & " rows processed."
'            Me.lblMsg.Caption = "Total of " & lRecords & " rows processed."

'exit_Here:
'            ' Cleanup all objects  (resume next on errors)
'            On Error Resume Next
'            wks = Nothing
'            wbk = Nothing
'            appExcel = Nothing
'            rst = Nothing
'            dbs = Nothing
'            DoCmd.Hourglass(False)
'            Exit Function

'err_Handler:
'            ExportRequest = Err.Description
'            Me.lblMsg.Caption = Err.Description
'            Resume exit_Here

'        End Function